HyperLib 1997 Winter - Disc 1/HYPERLIB-1997-Winter-CD1.ISO.7z/HYPERLIB-1997-Winter-CD1.ISO/オンラインウェア/PRG/ICProgKit 1.3.sit/ICProgKit1.3/Goodies/ICGenericOverride/ICGenericOverride.p

Text File | 1995-04-23 | 15KB | 432 lines

unit ICGenericOverride;

(* Internet Config Generic Overide Component *)

(* Routine names have an ICGO prefix for Internet Config Generic Override. *)

(* This component is the framework for an Internet Config override *)
(* component. I've used it to replace the original IC ReadOnly and *)
(* IC RandomSignature components bodies with one common body. *)
(* The different between the two components is now contained isolated *)
(* in a separate file, ICSpecificOverride. *)

(* The component overrides the Internet Config Extension and *)
(* passes all calls through to the specific override to determine *)
(* whether it should be overridden. *)

(* This code has followed a fairly long path--Jager was the one who *)
(* originally started the work on the Random Signature component. *)
(* I based my code on his code and tried to get it work, in the *)
(* process finding and using some sample code from a develop article. *)
(* Eric translated the generic  parts of Random Signature to C to *)
(* implement a component of his own (fixing bugs and rewriting along *)
(* the way), and then modified to duplicate the behavior of *)
(* IC ReadOnly. Since then I have ported the changes back to Pascal *)
(* to form the basis of this generic override component, which I've *)
(* used for the IC 1.1 override components. *)

(* Consider it a collaborative work, as Eric *)
(* says "a bit of a Frankenstein's monster". *)

(* This release fixes a nasty bug in the Pascal example components, one which *)
(* prevents them from loading if their manufacturer code comes after *)
(* that of a previously registered component. If you use any component *)
(* based on this code, the old versions of IC ReadOnly and Random *)
(* Signature will probably stop working. *)

(* If you're implementing a component of your own, I strongly suggest *)
(* you contact either Eric or myself first. In any event, read *)
(* the section on the component manager in Inside Macintosh: More *)
(* Macintosh Toolbox very closely and test your component thoroughly. *)
(* You'll definitely want some tools off of develop 15, including *)
(* Komponent Killer, Reinstaller II and the "thing" dcmd. *)

(* This code is probably of adequate quality for most uses, but if *)
(* you are using it to implement a commercial-quality system, you *)
(* may want to rewrite it from the ground up. *)

(* Quinn "The Eskimo!" *)

(* with vast plagarism from... *)

(* Eric Kidd *)
(* [e-mail] *)

(* Thanks for all the work Eric! *)

interface

    uses
        Components;

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;

implementation

    uses
{$ifc undefined THINK_Pascal}
        Types, Files, QuickDraw, Aliases, Packages, Memory, Errors, ToolUtils, Resources,

        ICTypes,
{$endc}
        Folders, ICCAPI, ICKeys, ICComponentSelectors, ICSpecificOverride;

    function ICGODecStr (l: longint): Str32;
        var
            tmpstr: Str255;
    begin
        NumToString(l, tmpstr);
        ICGODecStr := tmpstr;
    end; (* ICGODecStr *)

(*  ICGOFixCloneRefCon *)

(* See Inside Macintosh: More Macintosh Toolbox p. 6-35 for *)
(* an overview of this silliness. It seems that when your globally- *)
(* registered component is opened by an application, the system *)
(* pulls a fast one under "certain circumstances" (not enough memory *)
(* in the system heap) and "clones" a locally-registered version *)
(* of your component, frying your RefCon in process. *)

(* What we need to do is determine if this is the case, and if so, *)
(* recover the RefCon by locating the original copy of the component. *)

(* The Officially Sactioned Way to do this is a bit of a hack. Global *)
(* components have an A5 world of zero when they are opened, but local *)
(* ones have it pre-set to the parent application's value. If your *)
(* supposedly global component detects that it has a pre-set A5 world, *)
(* then it's been cloned. *)

(* To find the original copy of the component (which has the RefCon we *)
(* need), we need to find another component that looks exactly like us, *)
(* with the exception of a different component identifier. Unless we've *)
(* been registered globally multiple times under the same name, this *)
(* should work. FindNextComponent will do the job here. *)

(* The "practical upshot" of this: *)
(* 1) Only call this routine when handling open messages *)
(* 2) Call it before setting your instance's A5 world *)
(* 3) Only call it if you should have been global *)
(* 4) It won't work if you've been registered multiple times *)
(*      under the same name. *)
(* 5) Don't use the same manufacturer code for different *)
(*      components with the same type/subtype *)
(* 6) It may not work at all. I'm a college student, dammit, not a *)
(*      programming guru. *)

(* Eric Kidd *)
(* [e-mail] *)
(* 16 Dec 94 *)

    function ICGOFixCloneRefCon (self: ComponentInstance): ComponentResult;
        var
            err: OSErr;
            junk: OSErr;
            cd: ComponentDescription;
            current: Component;
    begin
        err := noErr;
        if (GetComponentRefcon(Component(self)) = 0) & (GetComponentInstanceA5(self) <> 0) then begin
            (* if this component has not been opened & setup*)
            (*     and we've been cloned*)

            (* get enough info about ourself to recognize the original *)
            junk := GetComponentInfo(Component(self), cd, nil, nil, nil);
            cd.componentFlagsMask := 0;        (* these shouldn't be relevant *)

            current := nil;
            repeat
                (* loop until we find someone other than ourself *)
                current := FindNextComponent(current, cd);
            until current <> Component(self);

            (* We didn't find any original--this happens often.*)
            (* If we've been captured, we can't find the original*)
            (*     copy. Best thing to do is return an error.*)

            if current = nil then begin
                err := paramErr;
            end
            else begin
                SetComponentRefcon(Component(self), GetComponentRefcon(current));
            end; (* if *)
        end; (* if *)
        ICGOFixCloneRefCon := err;
    end; (* ICGOFixCloneRefCon *)

    function ICGOGetSharedGlobals (globals: globalsHandle): ComponentResult;
        (* If the shared have not yet been allocated, we'll try to set them*)
        (* up and return them.*)
        var
            err: ComponentResult;
            shared: sharedGlobalsPtr;
            junk: OSErr;
    begin
        shared := sharedGlobalsPtr(GetComponentRefcon(Component(globals^^.self)));
        globals^^.shared := shared;
        if shared = nil then begin
            shared := sharedGlobalsPtr(NewPtrSysClear(sizeof(sharedGlobals)));
            err := MemError;
            if err = noErr then begin
                globals^^.shared := shared;
                (* init our part of the shared globals *)
                shared^.delegate := nil;
                (* and remember the shared globals in our refcon *)
                SetComponentRefcon(Component(globals^^.self), longint(shared));

                (* Since our shared globals get set up only once at registration*)
                (* time, here's the perfect place to move ourselves to the*)
                (* default position on the component list *)
                err := SetDefaultComponent(Component(globals^^.self), defaultComponentIdentical + defaultComponentAnyFlagsAnyManufacturer);
            end; (* if *)
            (* and init the specific globals *)
            if err = noErr then begin
                junk := ICSOInitShared(globals);
            end; (* if *)
        end; (* if *)

        ICGOGetSharedGlobals := err;
    end; (* ICGOGetSharedGlobals *)

(* Component Manager routines *)

    function ICGORegister (globals: globalsHandle): ComponentResult;
        (* I'd love to allocate shared globals here, but certain *)
        (*     versions of the Component Manager don't call ICGORegister. *)
        (*     Additionally, calls to ICGOOpen and ICGOClose bracket *)
        (*     the call if it does get made. Go figure. *)

        (* We actually return a Boolean value, false if we should be*)
        (* registered and true if we shouldn't.*)
    begin
        ICGORegister := 0;
    end; (* ICGORegister *)

    function ICGOUnregister (globals: globalsHandle): ComponentResult;
        (* Eric's comment: *)
        (*   Does this break if we've been cloned? Does the clone *)
        (*       get unregistered seperately and double dispose? Hmm. *)
        (* FIIK )-: *)
        var
            result: ComponentResult;
            result2: ComponentResult;
    begin
        result := -1;
        if globals^^.shared <> nil then begin
            (* give the specifics opportunity to clean up its shared globals *)
            result := ICSOCleanShared(globals);
            (* clean up our part of the shared globals *)
            result2 := UncaptureComponent(globals^^.shared^.delegate);
            if result = noErr then begin
                result := result2;
            end; (* if *)
            (* dispose of the shared globals and set our refcon back to nil *)
            DisposePtr(Ptr(globals^^.shared));
            globals^^.shared := nil;
            SetComponentRefcon(Component(globals^^.self), 0);
        end; (* if *)
        ICGOUnregister := result;
    end; (* ICGOUnregister *)

    function ICGOCanDo (globals: globalsHandle; selector: integer): ComponentResult;
    (* Handle the Component Manager CanDo request.*)
        var
            result: ComponentResult;
    begin
        case selector of
            kComponentUnregisterSelect..kComponentOpenSelect:
                result := 1;
            otherwise begin
                result := ICSOCanDo(globals, selector);
                if result = delegateThisCallErr then begin
                    result := ComponentFunctionImplemented(globals^^.delegate, selector);
                end
                else begin
                    result := result + 1;
                end; (* if *)
            end;
        end; (* case *)
        ICGOCanDo := result;
    end; (* ICGOCanDo *)

    function ICGOFindDelegate (after: Component): Component;
        var
            cd: ComponentDescription;
            found_cd: ComponentDescription;
            current: Component;
            found: boolean;
    begin
        cd.componentType := internetConfigurationComponentType;
        cd.componentSubType := internetConfigurationComponentSubType;
        cd.componentManufacturer := OSType(0);
        cd.componentFlags := 0;
        cd.componentFlagsMask := 0;
        current := after;
        found := false;
        repeat
            current := FindNextComponent(current, cd);
            if current <> nil then begin
                if GetComponentInfo(current, found_cd, nil, nil, nil) = noErr then begin
                    found := (found_cd.componentManufacturer <> kOurComponentManufacturer);
                end; (* if *)
            end; (* if *)
        until found or (current = nil);
        if current = nil then begin
(* DebugStr('ICGOFindDelegate failed to find one.'); *)
        end; (* if *)
        ICGOFindDelegate := current;
    end; (* ICGOFindDelegate *)

(* ICGOOpen *)

(* This function has been substanially recrafted from the original. Cloning *)
(* is now handled correctly (see the description of ICGOFixCloneRefCon) and error *)
(* handling has been made more graceful by the addition of a dedicated control *)
(* structure. A memory leak has been closed and OpenComponent can no longer *)
(* be called on a NULL component instance. *)

(* If you're using the pascal version, you'll want to carefully examine the *)
(* differences. *)

    function ICGOOpen (globals: globalsHandle; self: ComponentInstance): ComponentResult;
        var
            err: ComponentResult;
            cap: Component;
            toCapture: Component;
    begin
        globals := nil;
        err := ICGOFixCloneRefCon(self);
        if err = noErr then begin
            globals := globalsHandle(NewHandleClear(sizeof(globalsRecord)));
            err := MemError;
        end; (* if *)
        if err = noErr then begin
            HLock(Handle(globals));

            globals^^.self := self;
            SetComponentInstanceStorage(self, Handle(globals));
            err := ICGOGetSharedGlobals(globals);
        end; (* if *)

        if err = noErr then begin
            (* If we haven't yet done so, find and capture the*)
            (*     topmost IC component. We'll save the special*)
            (*     component identifier which will permit us to*)
            (* open it.*)
            if globals^^.shared^.delegate = nil then begin
                toCapture := ICGOFindDelegate(Component(self));
                if toCapture = nil then begin
                    err := icNothingToOverrideErr;
                end
                else begin
                    globals^^.shared^.delegate := CaptureComponent(toCapture, Component(self));
                end; (* if *)
            end; (* if *)
            if err = noErr then begin
                globals^^.delegate := OpenComponent(globals^^.shared^.delegate);
                err := ComponentSetTarget(self, self);
            end; (* if *)
            if err = noErr then begin
                err := ICSOInitGlobals(globals);
            end; (* if *)
        end; (* if *)

        if globals <> nil then begin
            HUnlock(Handle(globals));
        end; (* if *)
        if err <> noErr then begin
            if globals <> nil then begin
                DisposeHandle(Handle(globals));
                SetComponentInstanceStorage(self, nil);
            end; (* if *)
        end; (* if *)

        ICGOOpen := err;
    end; (* ICGOOpen *)

    function ICGOClose (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Close request. *)
        var
            err: ComponentResult;
            junk: OSErr;
    begin
        err := noErr;
        if globals <> nil then begin
            junk := ICSOCleanGlobals(globals);
            if globals^^.delegate <> nil then begin
                junk := CloseComponent(globals^^.delegate)
            end; (* if *)
            DisposeHandle(Handle(globals));
        end; (* if *)
        ICGOClose := err;
    end; (* ICGOClose *)

    function ICGOTarget (globals: globalsHandle; new_target: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Target. *)
        var
            err: ComponentResult;
    begin
        globals^^.target := new_target;
        if globals^^.delegate <> nil then begin
            err := ComponentSetTarget(globals^^.delegate, new_target);
        end
        else begin
            err := noErr;
        end; (* if *)
        ICGOTarget := err;
    end; (* ICGOTarget *)

(* Internet Configuration specific routines *)

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
    (* Component entry point.  It's pretty neat IMHO. *)
        var
            proc: ProcPtr;
            s: signedByte;
            res: longint;
    begin
        proc := nil;
{$ifc debug_component_entry_exit}
        DebugStr(concat('Enter ', SelectorToStr(params.what)));
{$endc}
        case params.what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                Main := internetConfigurationComponentInterfaceVersion;
            kComponentCanDoSelect:
                proc := @ICGOCanDo;
            kComponentOpenSelect:
                proc := @ICGOOpen;
            kComponentCloseSelect:
                proc := @ICGOClose;
            kComponentTargetSelect:
                proc := @ICGOTarget;
            kComponentRegisterSelect:
                proc := @ICGORegister;
            kComponentUnregisterSelect:
                proc := @ICGOUnregister;
            (* this component type stuff *)
            otherwise
                proc := ICSOWhatToOverride(globalsHandle(storage), params.what);
        end; (* case *)
        if storage <> nil then begin
            s := HGetState(storage);
            HLock(storage);
        end; (* if *)
        res := delegateThisCallErr;
        if proc <> nil then begin
            res := CallComponentFunctionWithStorage(storage, params, proc);
        end; (* if *)
        if res = delegateThisCallErr then begin
            res := DelegateComponentCall(params, globalsHandle(storage)^^.delegate);
        end; (* if *)
{$ifc debug_component_entry_exit}
        DebugStr(concat('Exit ', SelectorToStr(params.what), ' with result ', ICGODecStr(res)));
{$endc}
        Main := res;
        if (storage <> nil) and (params.what <> kComponentCloseSelect) then begin
            HSetState(storage, s);
        end; (* if *)
    end; (* Main *)

end. (* ICGenericOverride *)